In DFE-Capital/Blockbuster-2: Deterioration Model of the School Estate
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
# It is recommended that you load in any scripts your require in the markdown here. E.g:
library(ggplot2)
library(openxlsx)
library(dplyr)
library(scales)
format_money <- function(m, digits = 2){
if(length(digits) != 1 && length(m) != length(digits)) stop("The two arguments must be of the same length.")
neg <- m < 0 & !is.na(m) # to identify negative values (NAs are false)
m <- m * (-1)^ neg
exponent <- floor(log10(m) / 3)
exponent[exponent < 0] <- 0
suffix <- c("", "K", "M", "B", "T")[exponent + 1]
results <- paste0("£", signif(m, digits) / (10 ^ (exponent * 3)), suffix)
results[is.na(m)] <- NA
results[neg] <- paste0("-", results[neg])
return(results)
}
backlog <- openxlsx::read.xlsx(file.path(params$path), 1) %>%
mutate(`Year on year change` = backlog - c(NA, backlog[-length(backlog)]),
year = year + params$start_year)
totals <- openxlsx::read.xlsx(file.path(params$path), 2) %>%
mutate(year = year + params$start_year)
builds <- openxlsx::read.xlsx(file.path(params$path), 4) %>%
mutate(Year = Year + params$start_year)
Output matrix
repair_money <- strsplit(params$repair_money, ", ")[[1]] %>% as.numeric
rebuild_money <- strsplit(params$rebuild_money, ", ")[[1]] %>% as.numeric
last_year <- totals %>% filter(year == max(year)) %>%
mutate(grade = case_when( # combine grades D and E as E is model internal
grade %in% c("D", "E") ~ "D",
TRUE ~ as.character(grade)),
grade = factor(grade, levels = c("D", "C", "B", "A"))) %>%
group_by(grade) %>%
summarise(area = sum(area), backlog = sum(backlog))
total_area <- sum(last_year$area)
last_year <- last_year %>% mutate(area = area / total_area)
`Level of investment` <- format_money(sum(rebuild_money + repair_money))
`Value of backlog` <- backlog %>% filter(year == max(year)) %>% pull(backlog) %>% format_money
`Number of buildings rebuilt` <- sum(builds$Number.of.rebuilds)
`Number of buildings in need of rebuilding` <- builds$Number.of.buildings.in.need.of.rebuilding[nrow(builds)]
`Cost to rebuild in need buildings` <- builds$Cost.of.rebuilding.in.need.buildings[nrow(builds)] %>% format_money
`Estate at A` <- last_year %>% filter(grade == "A") %>%
pull(area) %>% ifelse(length(.) < 1, 0, .)
`Estate at B` <- last_year %>% filter(grade == "B") %>%
pull(area) %>% ifelse(length(.) < 1, 0, .)
`Estate at C` <- last_year %>% filter(grade == "C") %>%
pull(area) %>% ifelse(length(.) < 1, 0, .)
`Estate at D` <- last_year %>% filter(grade == "D") %>%
pull(area) %>% ifelse(length(.) < 1, 0, .)
pupils <- c(8406181, 8520189, 8605301, 8677929, 8738575, 8771860, 8789721,
8784848, 8781830, 8766692, 8736775, 8689746, 8658017, 8635628,
8613873, 8588705, 8578881, 8561901, 8546396, 8533374, 8524127,
8519215, 8537072, 8556856, 8583943, 8617228, 8655872, 8698621,
8744151, 8791072, 8837951, 8883329, 8930701, 8976555, 9019528,
9058499, 9092502)
pupils <- data.frame(year = 2020:2056, pupils) %>%
filter(year == max(backlog$year)) %>%
pull(pupils)
`Pupils in C` <- pupils * `Estate at C`
`Pupils in D` <- pupils * `Estate at D`
`Pupils in A or B` <- pupils * (`Estate at A` + `Estate at B`)
`Estate at A` <- paste(round(`Estate at A` * 100, 1), "%", sep = "")
`Estate at B` <- paste(round(`Estate at B` * 100, 1), "%", sep = "")
`Estate at C` <- paste(round(`Estate at C` * 100, 1), "%", sep = "")
`Estate at D` <- paste(round(`Estate at D` * 100, 1), "%", sep = "")
output_matrix <- data.frame(`Level of investment`, `Value of backlog`,
`Number of buildings rebuilt`, `Number of buildings in need of rebuilding`,
`Cost to rebuild in need buildings`,
`Estate at A`,
`Estate at B`,
`Estate at C`,
`Estate at D`,
`Pupils in A or B`, `Pupils in C`, `Pupils in D`)
knitr::kable(output_matrix, format = "markdown", format.args = list(big.mark = ","),
col.names = c("Level of investment", "Value of backlog",
"Number of buildings rebuilt", "Number of buildings in need of rebuilding",
"Cost to rebuild in need buildings",
"Estate at A",
"Estate at B",
"Estate at C",
"Estate at D",
"Pupils in A or B", "Pupils in C", "Pupils in D"))
Backlog is defined as the cost to repair or replace all grade C and D need components.
Model parameters
The following outputs are from a Blockbuster Deterioration model run over r params$forecast_horizon years. A summary of the model parameters in provided below, but full details can be found in the accompanying Excel input.xlsm file.
knitr::kable(data.frame(Parameter = c(#"Deterioration rates", "Repair costs",
"Inflation on repair and rebuild costs",
"Block rebuild unit cost", "Repair order"),
"Value" = c(#params$det_rates, params$repair_costs,
params$inflation,
paste0("£", round(params$block_rebuild_cost,2), sep = ""),
paste(params$repair_order, collapse = ", "))),
format = "markdown")
# repair_money <- inputs$repair_budget
# rebuild_money <- inputs$rebuild_budget
The yearly budgets available for rebuilding and repairing are:
knitr::kable(format = "markdown", data.frame(Year = seq_len(params$forecast_horizon) + params$start_year,
`Repair budget` = format_money(repair_money),
`Rebuild budget` = format_money(rebuild_money)))
Model results
Expected backlog per year
knitr::kable(format = "markdown", backlog %>%
mutate(spend = format_money(c(NA, repair_money + rebuild_money)), `Year on year change` = format_money(`Year on year change`),
backlog = format_money(backlog)),
row.names = FALSE,
col.names = c("Year", "Backlog after investment", "Year on year change", "Investment"))
Expected backlog per year
backlog %>%
ggplot(aes(x = factor(year), y = backlog, group = 1)) +
geom_bar(stat= "identity", fill = "#2B8CC4") +
theme_gov() +
theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) +
xlab("Year") +
ylab("Backlog") +
scale_y_continuous(label = format_money)
Expected backlog by condition grades
totals %>%
filter(grade != "A") %>%
mutate(grade = case_when( # combine grades D and E as E is model internal
grade %in% c("D", "E") ~ "D",
TRUE ~ as.character(grade)),
grade = factor(grade, c("D", "C", "B"))) %>%
group_by(grade, year) %>%
summarise(backlog = sum(backlog),
area = sum(area)) %>%
mutate(label = paste(grade, ": ", format_money(backlog), sep = "")) %>%
ggplot(aes(x = factor(year), backlog, fill = grade)) +
theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) +
geom_bar(stat = "identity") +
theme_gov() +
xlab("Year") +
ylab("Backlog") +
scale_y_continuous(labels=format_money) +
scale_fill_manual(values = gov_cols[c("red", "yellow", "grass_green")] %>% unname) +
geom_text(aes(label = label), vjust = 1, position = "stack")
Yearly change in expected backlog
backlog %>%
ggplot(aes(x = factor(year), y = `Year on year change`, group = 1)) +
theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) +
geom_line() +
geom_point() +
geom_text(aes(label = year), nudge_y = diff(range(backlog$`Year on year change`, na.rm = TRUE) / 20)) +
theme_gov() +
xlab("Year") +
scale_y_continuous(label = format_money) +
expand_limits(y = 0)
Expected proportion by condition grades
total_area <- totals %>% group_by(year) %>% summarise(total_area = sum(area))
totals %>%
mutate(grade = case_when( # combine grades D and E as E is model internal
grade %in% c("D", "E") ~ "D",
TRUE ~ as.character(grade)),
grade = factor(grade, levels = c("D", "C", "B", "A"))) %>%
left_join(total_area) %>%
group_by(grade, year) %>%
summarise(area = sum(area / total_area)) %>%
mutate(label = paste(grade, ": ", round(area * 100,1), "%", sep = "")) %>%
ggplot(aes(x = factor(year), y = area, fill = grade)) +
geom_bar(stat="identity") +
geom_text(aes(label = label), vjust = 1, position = "stack") +
theme_gov() +
theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) +
xlab("Year") +
ylab("Percentage of estate") +
scale_y_continuous(labels=scales::percent) +
scale_fill_manual(values = gov_cols[c("red", "yellow", "grass_green", "green")] %>% unname)
DFE-Capital/Blockbuster-2 documentation built on May 26, 2019, 7:23 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE) # It is recommended that you load in any scripts your require in the markdown here. E.g: library(ggplot2) library(openxlsx) library(dplyr) library(scales) format_money <- function(m, digits = 2){ if(length(digits) != 1 && length(m) != length(digits)) stop("The two arguments must be of the same length.") neg <- m < 0 & !is.na(m) # to identify negative values (NAs are false) m <- m * (-1)^ neg exponent <- floor(log10(m) / 3) exponent[exponent < 0] <- 0 suffix <- c("", "K", "M", "B", "T")[exponent + 1] results <- paste0("£", signif(m, digits) / (10 ^ (exponent * 3)), suffix) results[is.na(m)] <- NA results[neg] <- paste0("-", results[neg]) return(results) }
backlog <- openxlsx::read.xlsx(file.path(params$path), 1) %>% mutate(`Year on year change` = backlog - c(NA, backlog[-length(backlog)]), year = year + params$start_year) totals <- openxlsx::read.xlsx(file.path(params$path), 2) %>% mutate(year = year + params$start_year) builds <- openxlsx::read.xlsx(file.path(params$path), 4) %>% mutate(Year = Year + params$start_year)
Output matrix
repair_money <- strsplit(params$repair_money, ", ")[[1]] %>% as.numeric rebuild_money <- strsplit(params$rebuild_money, ", ")[[1]] %>% as.numeric last_year <- totals %>% filter(year == max(year)) %>% mutate(grade = case_when( # combine grades D and E as E is model internal grade %in% c("D", "E") ~ "D", TRUE ~ as.character(grade)), grade = factor(grade, levels = c("D", "C", "B", "A"))) %>% group_by(grade) %>% summarise(area = sum(area), backlog = sum(backlog)) total_area <- sum(last_year$area) last_year <- last_year %>% mutate(area = area / total_area) `Level of investment` <- format_money(sum(rebuild_money + repair_money)) `Value of backlog` <- backlog %>% filter(year == max(year)) %>% pull(backlog) %>% format_money `Number of buildings rebuilt` <- sum(builds$Number.of.rebuilds) `Number of buildings in need of rebuilding` <- builds$Number.of.buildings.in.need.of.rebuilding[nrow(builds)] `Cost to rebuild in need buildings` <- builds$Cost.of.rebuilding.in.need.buildings[nrow(builds)] %>% format_money `Estate at A` <- last_year %>% filter(grade == "A") %>% pull(area) %>% ifelse(length(.) < 1, 0, .) `Estate at B` <- last_year %>% filter(grade == "B") %>% pull(area) %>% ifelse(length(.) < 1, 0, .) `Estate at C` <- last_year %>% filter(grade == "C") %>% pull(area) %>% ifelse(length(.) < 1, 0, .) `Estate at D` <- last_year %>% filter(grade == "D") %>% pull(area) %>% ifelse(length(.) < 1, 0, .) pupils <- c(8406181, 8520189, 8605301, 8677929, 8738575, 8771860, 8789721, 8784848, 8781830, 8766692, 8736775, 8689746, 8658017, 8635628, 8613873, 8588705, 8578881, 8561901, 8546396, 8533374, 8524127, 8519215, 8537072, 8556856, 8583943, 8617228, 8655872, 8698621, 8744151, 8791072, 8837951, 8883329, 8930701, 8976555, 9019528, 9058499, 9092502) pupils <- data.frame(year = 2020:2056, pupils) %>% filter(year == max(backlog$year)) %>% pull(pupils) `Pupils in C` <- pupils * `Estate at C` `Pupils in D` <- pupils * `Estate at D` `Pupils in A or B` <- pupils * (`Estate at A` + `Estate at B`) `Estate at A` <- paste(round(`Estate at A` * 100, 1), "%", sep = "") `Estate at B` <- paste(round(`Estate at B` * 100, 1), "%", sep = "") `Estate at C` <- paste(round(`Estate at C` * 100, 1), "%", sep = "") `Estate at D` <- paste(round(`Estate at D` * 100, 1), "%", sep = "") output_matrix <- data.frame(`Level of investment`, `Value of backlog`, `Number of buildings rebuilt`, `Number of buildings in need of rebuilding`, `Cost to rebuild in need buildings`, `Estate at A`, `Estate at B`, `Estate at C`, `Estate at D`, `Pupils in A or B`, `Pupils in C`, `Pupils in D`)
knitr::kable(output_matrix, format = "markdown", format.args = list(big.mark = ","), col.names = c("Level of investment", "Value of backlog", "Number of buildings rebuilt", "Number of buildings in need of rebuilding", "Cost to rebuild in need buildings", "Estate at A", "Estate at B", "Estate at C", "Estate at D", "Pupils in A or B", "Pupils in C", "Pupils in D"))
Backlog is defined as the cost to repair or replace all grade C and D need components.
Model parameters
The following outputs are from a Blockbuster Deterioration model run over r params$forecast_horizon years. A summary of the model parameters in provided below, but full details can be found in the accompanying Excel input.xlsm file.
knitr::kable(data.frame(Parameter = c(#"Deterioration rates", "Repair costs", "Inflation on repair and rebuild costs", "Block rebuild unit cost", "Repair order"), "Value" = c(#params$det_rates, params$repair_costs, params$inflation, paste0("£", round(params$block_rebuild_cost,2), sep = ""), paste(params$repair_order, collapse = ", "))), format = "markdown") # repair_money <- inputs$repair_budget # rebuild_money <- inputs$rebuild_budget
The yearly budgets available for rebuilding and repairing are:
knitr::kable(format = "markdown", data.frame(Year = seq_len(params$forecast_horizon) + params$start_year, `Repair budget` = format_money(repair_money), `Rebuild budget` = format_money(rebuild_money)))
Model results
Expected backlog per year
knitr::kable(format = "markdown", backlog %>% mutate(spend = format_money(c(NA, repair_money + rebuild_money)), `Year on year change` = format_money(`Year on year change`), backlog = format_money(backlog)), row.names = FALSE, col.names = c("Year", "Backlog after investment", "Year on year change", "Investment"))
Expected backlog per year
backlog %>% ggplot(aes(x = factor(year), y = backlog, group = 1)) + geom_bar(stat= "identity", fill = "#2B8CC4") + theme_gov() + theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) + xlab("Year") + ylab("Backlog") + scale_y_continuous(label = format_money)
Expected backlog by condition grades
totals %>% filter(grade != "A") %>% mutate(grade = case_when( # combine grades D and E as E is model internal grade %in% c("D", "E") ~ "D", TRUE ~ as.character(grade)), grade = factor(grade, c("D", "C", "B"))) %>% group_by(grade, year) %>% summarise(backlog = sum(backlog), area = sum(area)) %>% mutate(label = paste(grade, ": ", format_money(backlog), sep = "")) %>% ggplot(aes(x = factor(year), backlog, fill = grade)) + theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) + geom_bar(stat = "identity") + theme_gov() + xlab("Year") + ylab("Backlog") + scale_y_continuous(labels=format_money) + scale_fill_manual(values = gov_cols[c("red", "yellow", "grass_green")] %>% unname) + geom_text(aes(label = label), vjust = 1, position = "stack")
Yearly change in expected backlog
backlog %>% ggplot(aes(x = factor(year), y = `Year on year change`, group = 1)) + theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) + geom_line() + geom_point() + geom_text(aes(label = year), nudge_y = diff(range(backlog$`Year on year change`, na.rm = TRUE) / 20)) + theme_gov() + xlab("Year") + scale_y_continuous(label = format_money) + expand_limits(y = 0)
Expected proportion by condition grades
total_area <- totals %>% group_by(year) %>% summarise(total_area = sum(area)) totals %>% mutate(grade = case_when( # combine grades D and E as E is model internal grade %in% c("D", "E") ~ "D", TRUE ~ as.character(grade)), grade = factor(grade, levels = c("D", "C", "B", "A"))) %>% left_join(total_area) %>% group_by(grade, year) %>% summarise(area = sum(area / total_area)) %>% mutate(label = paste(grade, ": ", round(area * 100,1), "%", sep = "")) %>% ggplot(aes(x = factor(year), y = area, fill = grade)) + geom_bar(stat="identity") + geom_text(aes(label = label), vjust = 1, position = "stack") + theme_gov() + theme(panel.grid.major.y = element_line(colour = "grey", linetype = "dotted")) + xlab("Year") + ylab("Percentage of estate") + scale_y_continuous(labels=scales::percent) + scale_fill_manual(values = gov_cols[c("red", "yellow", "grass_green", "green")] %>% unname)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.